{
  This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
  the Free Software Foundation; version 2 of the License.
   
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
}

// Copyright (c) 2010 2011 2012 - J. Aldo G. de Freitas Junior

{$mode objfpc}
{$H+}

Unit
	XMLNodes;

Interface

Uses
	Classes,
	Contnrs,
	SysUtils,
	BaseException,
	RTTIObjects,
	Tree,
	StrUtils;

Type
	EXMLNode = Class(EInterpreterException);

	TXMLTextNode = Class;
	TXMLNode = Class;
	TXMLNodeClass = Class Of TXMLNode;

	TXMLNode = Class(TTreeNode)
	Private
		fRow,
		fCol : Integer;
		fSource : String;
		fCapabilities : TStringList;
	Public
		Constructor Create(Const aOwner : TTreeNode); Override;
		Destructor Destroy; Override;
		Procedure RaiseError(Const aMsg : String);
		Function GetTextChild: String;
		Procedure SetTextChild(Const aContent : String);
		Function HasTextChild: Boolean;
		Function AsXML: String; Virtual;
		Function AsClosingXML: String; Virtual;
		Procedure AddCapability(Const aCapability : String);
		Procedure DelCapability(Const aCapability : String);
		Function IsCapableOf(Const aCapability : String): Boolean;
		// Properties
		Property Text : String Read GetTextChild Write SetTextChild;
		Property Row : Integer Read fRow Write fRow;
		Property Col : Integer Read fCol Write fCol;
		Property Source : String Read fSource Write fSource;
	End;

	TXMLSpecialTag1Node = Class(TXMLNode)
	Public
		Function AsXML: String; Override;
		Function AsClosingXML: String; Override;
	End;

	TXMLSpecialTag2Node = Class(TXMLNode)
	Public
		Function AsXML: String; Override;
		Function AsClosingXML: String; Override;
	End;

	TXMLTextNode = Class(TXMLNode)
	Private
		fContent : String;
	Public
		Function AsXML: String; Override;
		Function AsClosingXML: String; Override;
		Class Function RegisteredName : String; Override;
		Property Content : String Read fContent Write fContent;
	End;

	TXMLAsTextIterator = Class(TTreeNodeIterator)
	Private
		fDepth : Integer;
		fOutput : String;
	Public
		Constructor Create;
		Procedure Process(Const aTarget : TTreeNode); Override;
		Procedure OnNoChild(Const aTarget : TTreeNode); Override;
		Procedure OnBeforeSingleChild(Const aTarget : TTreeNode); Override;
		Procedure OnAfterSingleChild(Const aTarget : TTreeNode); Override;
		Procedure OnBeforeAllChilds(Const aTarget : TTreeNode); Override;
		Procedure OnAfterAllChilds(Const aTarget : TTreeNode); Override;
		Procedure OnBeforeChild(Const aTarget : TTreeNode); Override;
		Procedure OnAfterChild(Const aTarget : TTreeNode); Override;
		Property Output : String Read fOutput Write fOutput;
	End;

Implementation

// TXMLNode

Constructor TXMLNode.Create(Const aOwner : TTreeNode);
Begin
	Inherited Create(aOwner);
	fCapabilities := TStringList.Create;
	fCapabilities.Duplicates := dupIgnore;
	fCapabilities.Sorted := True;
	ReadOnly := False;
End;

Destructor TXMLNode.Destroy;
Begin
	FreeAndNil(fCapabilities);
	Inherited Destroy;
End;

Procedure TXMLNode.RaiseError(Const aMsg : String);
Var
	lException : EXMLNode;
Begin
	lException := EXMLNode.Create(Row, Col, Source, Nil);
	lException.Messages.Add('XML file : ' + aMsg);
	Raise lException;
End;

Function TXMLNode.GetTextChild: String;
Begin
	If HasTextChild Then
		Result := (GetFirst As TXMLTextNode).Content
	Else
		RaiseError('No text attached to node');
	Result := StringReplace(Result, '&quot;', '"', [ rfReplaceAll ]);
	Result := StringReplace(Result, '&apos;', '''', [ rfReplaceAll ]);
	Result := StringReplace(Result, '&lt;', '<', [ rfReplaceAll ]);
	Result := StringReplace(Result, '&gt;', '>', [ rfReplaceAll ]);
	Result := StringReplace(Result, '&amp;', '&', [ rfReplaceAll ]);
	Result := StringReplace(Result, '&nbsp;', ' ', [ rfReplaceAll ]);
	Result := StringReplace(Result, '&lend', LineEnding, [ rfReplaceAll ]);
End;

Procedure TXMLNode.SetTextChild(Const aContent : String);
Var
	lBuffer : String;
Begin
	lBuffer := aContent;
	lBuffer := StringReplace(lBuffer, '&', '&amp;', [ rfReplaceAll ]);
	lBuffer := StringReplace(lBuffer, '"', '&quot;', [ rfReplaceAll ]);
	lBuffer := StringReplace(lBuffer, '''', '&apos;', [ rfReplaceAll ]);
	lBuffer := StringReplace(lBuffer, '<', '&lt;', [ rfReplaceAll ]);
	lBuffer := StringReplace(lBuffer, '>', '&gt;', [ rfReplaceAll ]);
	lBuffer := StringReplace(lBuffer, ' ', '&nbsp;', [ rfReplaceAll ]);
	lBuffer := StringReplace(lBuffer, LineEnding, '&lend', [ rfReplaceAll ]);
	If HasTextChild Then
		(GetFirst As TXMLTextNode).Content := lBuffer
	Else
		TXMLTextNode.Create(Self).Content := lBuffer;
End;

Function TXMLNode.HasTextChild: Boolean;
Begin
	Result := (Length(Childs) > 0) And (Assigned(GetFirst) And (GetFirst Is TXMLTextNode));
End;

Function TXMLNode.AsXML: String;
Begin
	If PropertyCount > 0 Then
		If Length(Childs) > 0 Then
			Result := '<' + RegisteredName + ' ' + FormattedProperties + '>'
		Else
			Result := '<' + RegisteredName + ' ' + FormattedProperties + '/>'
	Else
		If Length(Childs) > 0 Then
			Result := '<' + RegisteredName + '>'
		Else
			Result := '<' + RegisteredName + '/>';
	// Debug  WriteLn(Result);
End;

Function TXMLNode.AsClosingXML: String;
Begin
	Result := '</' + RegisteredName + '>';
	// Debug  WriteLn(Result);
End;

Procedure TXMLNode.AddCapability(Const aCapability : String);
Begin
	fCapabilities.Add(aCapability);
End;

Procedure TXMLNode.DelCapability(Const aCapability : String);
Var
	lIndex : Integer;
Begin
	lIndex := fCapabilities.IndexOf(aCapability);
	If lIndex >= 0 Then
		fCapabilities.Delete(lIndex)
	Else
		RaiseError('Node has no capability to delete.');
End;

Function TXMLNode.IsCapableOf(Const aCapability : String): Boolean;
Begin
	// Debug  WriteLn(' Is fCapabilities allocated ? ', Integer(Pointer(fCapabilities)));
	Result := fCapabilities.IndexOf(aCapability) >= 0;
End;

// TXMLSpecialTag1Node

Function TXMLSpecialTag1Node.AsXML: String;
Begin
	If PropertyCount > 0 Then
		Result := '<?' + RegisteredName + ' ' + FormattedProperties + '?>'
	Else
		Result := '<?' + RegisteredName + '?>';
End;

Function TXMLSpecialTag1Node.AsClosingXML: String;
Begin
	Result := '';
End;

// TXMLSpecialTag2Node

Function TXMLSpecialTag2Node.AsXML: String;
Begin
	If PropertyCount > 0 Then
		Result := '<!' + RegisteredName + ' ' + FormattedProperties + '!>'
	Else
		Result := '<!' + RegisteredName + '!>';
End;

Function TXMLSpecialTag2Node.AsClosingXML: String;
Begin
	Result := '';
End;

// TXMLTextNode

Function TXMLTextNode.AsXML: String;
Begin
	Result := fContent;
End;

Function TXMLTextNode.AsClosingXML: String;
Begin
	Result := '';
End;

Class Function TXMLTextNode.RegisteredName : String;
Begin
	Result := 'text';
End;

// TXMLAsTextIterator

Constructor TXMLAsTextIterator.Create;
Begin
	Inherited Create;
	fDepth := -1;
	fOutput := '';
End;

Procedure TXMLAsTextIterator.Process(Const aTarget : TTreeNode);
Begin
End;

Procedure TXMLAsTextIterator.OnNoChild(Const aTarget : TTreeNode);
Begin
	If aTarget Is TXMLTextNode Then
		fOutput := fOutput + (aTarget As TXMLNode).AsXML
	Else
		If Assigned(aTarget.Owner) And (Length(aTarget.Owner.Childs) = 1) Then
			fOutput := fOutput + (aTarget As TXMLNode).AsXML
		Else
			fOutput := fOutput + DupeString(' ', fDepth) + (aTarget As TXMLNode).AsXML;
End;

Procedure TXMLAsTextIterator.OnBeforeSingleChild(Const aTarget : TTreeNode);
Begin
	If Assigned(aTarget.Owner) And (Length(aTarget.Owner.Childs) = 1) Then
		fOutput := fOutput + (aTarget As TXMLNode).AsXML
	Else
		If aTarget.GetFirst Is TXMLTextNode Then
			fOutput := fOutput + DupeString(' ', fDepth) + (aTarget As TXMLNode).AsXML
		Else
			fOutput := fOutput + DupeString(' ', fDepth) + (aTarget As TXMLNode).AsXML + LineEnding;
	Inc(fDepth);
End;

Procedure TXMLAsTextIterator.OnAfterSingleChild(Const aTarget : TTreeNode);
Begin
	Dec(fDepth);
	If aTarget.GetFirst Is TXMLTextNode Then
		fOutput := fOutput + (aTarget As TXMLNode).AsClosingXML
	Else
		fOutput := fOutput + LineEnding + DupeString(' ', fDepth) + (aTarget As TXMLNode).AsClosingXML;
End;

Procedure TXMLAsTextIterator.OnBeforeAllChilds(Const aTarget : TTreeNode);
Begin
	fOutput := fOutput + DupeString(' ', fDepth) + (aTarget As TXMLNode).AsXML + LineEnding;
	Inc(fDepth);
End;

Procedure TXMLAsTextIterator.OnAfterAllChilds(Const aTarget : TTreeNode);
Begin
	Dec(fDepth);
	fOutput := fOutput + DupeString(' ', fDepth) + (aTarget As TXMLNode).AsClosingXML;
End;

Procedure TXMLAsTextIterator.OnBeforeChild(Const aTarget : TTreeNode);
Begin
End;

Procedure TXMLAsTextIterator.OnAfterChild(Const aTarget : TTreeNode);
Begin
	fOutput := fOutput + LineEnding;
End;

End.
